home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / PGM_TOOL / TPRCDR10 / LDIR.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-26  |  4KB  |  100 lines

  1. { ╔═══════════╤════════════════════════════════════════════════╗
  2.   ║ Programmer│ Tony Papadimitriou                             ║
  3.   ║ Program   │ LDIR                                           ║
  4.   ║ Uses      │ Dos, TPUtils, TPRecDir                         ║
  5.   ║ Includes  │ Nothing                                        ║
  6.   ║ Links     │ Nothing                                        ║
  7.   ║ Created   │ Sunday, December 19, 1993  2:08 am             ║
  8.   ║ Updated   │ Saturday, December 25, 1993  3:50 pm           ║
  9.   ║ Language  │ (MSDOS) Turbo Pascal 6.0                       ║
  10.   ║ Purpose   │ Show off TPRecDir unit                         ║
  11.   ╟───────────┴┬──────── Version History ──────────────────────╢
  12.   ║ 1.00       │Original                                       ║
  13.   ╚════════════╧═══════════════════════════════════════════════╝ }
  14. uses
  15.   Dos,
  16.   TPUtils,
  17.   TPRecDir;
  18.  
  19. const
  20.   progName = 'LDIR';
  21.   version  = '1.00';
  22.  
  23. procedure Copyright;
  24. begin
  25.   Writeln(stderr);
  26.   Writeln(stderr,progName+' ver. ' + version + ' ■ Copyright (c) 1993-94 by Tony G. Papadimitriou *FREEWARE*');
  27.   Writeln(stderr);
  28. end; { Copyright }
  29.  
  30. var
  31.   archives,              { number of archive matches }
  32.   hiddenfiles,           { number of hidden files }
  33.   sysfiles,              { number of system files }
  34.   readonlys,             { number of read-only files }
  35.   dirs,                  { number of directories (any attribute) }
  36.   files:       Longint;  { number of files (any attribute) }
  37.  
  38. { --- this is the user routine whose address you must supply to ForEachFileIn }
  39. function List(rec: SearchRec): Boolean; far;
  40.   { 1 } procedure PrintAttr(attr,testAttr: Word; printChar: Char; var counter: Longint);
  41.         begin
  42.           if AttributeMatches(attr,testAttr) then
  43.           begin
  44.             Write(printChar);
  45.             Inc(counter);
  46.           end
  47.           else
  48.             Write('-');
  49.         end; { PrintAttr }
  50. begin
  51.   List := True;
  52.   if AttributeMatches(rec.attr,Directory) then
  53.     Inc(dirs)
  54.   else
  55.   begin
  56.     PrintAttr(rec.attr,Archive, 'A',archives);
  57.     PrintAttr(rec.attr,SysFile, 'S',sysfiles);
  58.     PrintAttr(rec.attr,Hidden,  'H',hiddenfiles);
  59.     PrintAttr(rec.attr,ReadOnly,'R',readonlys);
  60.     Inc(files);
  61.     Writeln('  ',FExpand(rec.name));
  62.   end;
  63. end; { List }
  64.  
  65. var
  66.   counter: Longint;
  67.   path   : String;
  68.   mask   : String;
  69. begin
  70.   Copyright;
  71.   if ParamCount = 0 then
  72.   begin
  73.     Writeln(stderr,'Usage: LDIR [<path>\]<mask>[;<mask>]');
  74.     Writeln(stderr);
  75.     Writeln(stderr,'       Press ESC during search to interrupt prematurely.');
  76.     Halt;
  77.   end; { if }
  78.   archives    := 0;
  79.   hiddenfiles := 0;
  80.   sysfiles    := 0;
  81.   readonlys   := 0;
  82.   dirs        := 0;
  83.   files       := 0;
  84.   path := ParamStr(1);
  85.   mask := GetMask(path);
  86.   path := GetPath(path);
  87.   counter := ForEachFileIn(path,mask,AnyFile,True,True,@List);
  88.   if errorsFound then Writeln(stderr,'Errors during processing!');
  89.   Writeln(stderr,'Processed ',dirs,' dir'+OneManyStr(dirs,'','s')+
  90.                  ' and ',files,' file'+OneManyStr(files,'','s')+
  91.                  ' for a total of ',counter,' match'+OneManyStr(counter,'','es'));
  92.   Writeln(stderr);
  93.   Writeln(stderr,'In detail by attribute they are broken down as follows:');
  94.   Writeln(stderr,'──────────────────────────────────────────────────────');
  95.   Writeln(stderr,'Archives:        ',archives);
  96.   Writeln(stderr,'Hidden:          ',hiddenfiles);
  97.   Writeln(stderr,'System files:    ',sysfiles);
  98.   Writeln(stderr,'Read-only files: ',readonlys);
  99. end.
  100.